'OHRRPGCE COMMON - Lumped file format routines
'(C) Copyright 1997-2005 James Paige and Hamster Republic Productions
'Please read LICENSE.txt for GPL License details and disclaimer of liability



Type Lumptype Final
	Const LT_LUMPED:Int = 1
	Const LT_FILE:Int = 2
	'LT_FIXEDREC
	'LT_DIRTYMAP
	'LT_SUBLUMP
	Const LT_NUM:Int = 6
End Type


Type LumpedLump
	Field Ltype:Lumptype
	Field lumpname:String
	Field length:Int
	Field bucket_chain:Lump'Byte Ptr
	Field seq:TList ' as DListItem(Lump)
	Field index:LumpIndex
	Field opencount:Int' as integer 'refcount

	'usual FB start-from-one offset of start of data for this lump
	Field offset:Int' as integer
End Type


Type FileLump
	Field Ltype:Lumptype
	Field lumpname:String
	Field length:Int
	Field bucket_chain:Lump
	Field seq:TList' as DListItem(Lump)
	Field index:LumpIndex'
	Field opencount:Int 'eger 'refcount

	Field fhandle:Int'eger
	'if empty, file name is index->unlumpeddir + lumpname (FIXME: stupid)
	Field filename:String
	'temp file lumps are automatically deleted when their refcount hits 0, and the file removed
	Field istemp:Int = 1 'eger
	
	Method New()
		
	End Method
	
	Method unlump(status:TGadget=Null)'lumpfile as String, ulpath as String, byval showerrors as bool = YES)
		unlumpfile(status)'lumpfile, "", ulpath, showerrors)
	End Method


	Method LoadGeneralData()
		'bah crap some of the data is zero based.. derp
		xbload(GamePath+Game + ".gen", Gen)
		Upgrade()
		'so my rpg game has the wrong record count defaults so upgrade
		
	
	End Method
	
	Method Upgrade()
		Gen[genMaxHeroPic]   = 40
		Gen[genMaxEnemy1Pic] = 149
		Gen[genMaxEnemy2Pic] = 79
		Gen[genMaxEnemy3Pic] = 29
		Gen[genMaxNPCPic]    = 119
		Gen[genMaxWeaponPic] = 149
		Gen[genMaxAttackPic] = 99
		Gen[genMaxTile]      = 14
		Gen[genMaxAttack]    = 200
		Gen[genMaxHero]      = 59
		Gen[genMaxEnemy]     = 500
		Gen[genMaxFormation] = 1000
		Gen[genMaxPal]       = 99
		Gen[genMaxTextbox]   = 999	
		Gen[genMaxPortrait]	 = 84
	
	
	End Method

	Method UpgradeSongs()
	Rem
		'could not for the life of me find the official loadsong function so i took it from the shops function
		If FileType(GamePath + "songdata.bin") <> 1 Then
			'upgrade_message "Upgrading Song Name format..."
			Local song:String[99]' as String
			Local fh:TStream' = FREEFILE
			'fh = OpenFile(GamePath + Game + ".sng")
			Local temp:Int = FileSize(GamePath + Game + ".sng")
			'CLOSE #fh
			If temp > 0 Then
				'fh = FREEFILE
				fh = WriteFile(GamePath + Game + ".sng")
				For Local i:Int = 0 To 99
					'writing empty strings? wtf?
					WriteString(fh,song[i])'Input #fh, song(i)
				Next
				CloseFile(fh)
			End If	
		
		
			For Local i:Int = 99 To 1 Step -1
				'-- check for midis as well 'cause some people might use a WIP custom or whatnot
				If song[i] <> "" Or FileType(GamePath+Game+ "." + i) = 1 Or FileType(GamePath + "song" + i + ".mid")= 1 Then
					Gen[genMaxSong] = i
					Exit
				End If
			Next
		
			setbinsize binSONGDATA, curbinsize(binSONGDATA)
			flusharray buffer(), dimbinsize(binSONGDATA), 0
			setpicstuf buffer(), curbinsize(binSONGDATA), -1
			For i as integer = 0 To gen(genMaxSong)
			writebinstring song(i), buffer(), 0, 30
			storeset workingdir + SLASH + "songdata.bin", i, 0
			Next
			ERASE song
		End If		
	End Rem	
	End Method

	Method LoadRecord:Int(buffer:Int[], filen:String,recordsize:Int,record:Int = 0,expectfile:Byte = True)
		Local f:TStream' as integer
		Local i:Int' as integer
		
		If recordsize <= 0 Then Return -1
		
		If Not FileType(filen) = 1 Then
			If expectfile = True Then DebugLog "File not found loading record " + record + " from " + filen
			For i = 0 To recordsize - 1
				buffer[i] = 0
			Next
			Return -1
		End If
		'f = freefile
		f = ReadFile(filen)'open filen For binary access read as #f
		
		Return loadrecords (buffer, f, recordsize, record)
		CloseFile(f)	
	End Method



	
	Method LoadRecordStream:Int(buffer:Int[], f:TStream,recordsize:Int,record:Int = 0,expectfile:Byte = False)
		'Local f:TStream' as integer
		Local i:Int' as integer
		
		If recordsize <= 0 Then Return -1
		
		If f = Null Then
			If expectfile = True Then DebugLog "File not found loading record " + record
			For i = 0 To recordsize - 1
				buffer[i] = 0
			Next
			Return -1
		End If
		'f = freefile
		'f = ReadFile(filen)'open filen For binary access read as #f
		
		Return loadrecords (buffer, f, recordsize, record)
		'CloseFile(f)	
	End Method




	Method loadrecords:Int(buffer:Int[], f:TStream, recordsize:Int,record:Int = -1)
		'common sense alternative to loadset, setpicstuf
		'loads 16bit records in an array
		'buf() = buffer to load shorts into, starting at buf(0)
		'fh = open file handle
		'recordsize = record size in shorts (not bytes)
		'record = record number, defaults to read from current file position
		'returns true if successful, false if failure (eg. file too short)
		'Even if the file is too short, reads as much as possible
		
		Local idx:Int' as integer
		If recordsize <= 0 Then Return -1
		If buffer.Length < recordsize - 1 Then
			DebugLog "loadrecord: " + recordsize + " ints will not fit in " +buffer.Length+ " element array"
			'continue, fit in as much as possible
		End If
		Local readbuf:Short[recordsize ]' as Short
		
		If record <> -1 Then
			SeekStream( f,(recordsize * 2) * record)
			'seek #fh, recordsize * 2 * record + 1
		End If
		Local ret:Byte = True' as bool = YES
		If StreamPos( f ) + (2 * recordsize) > StreamSize(f)+1 Then ret = False' removed +1 after streamsize
		For Local i:Int = 0 To readbuf.Length-1
			If Not Eof(f)
				readbuf[i] = ReadShort(f)'get #fh, , readbuf()
			EndIf
		Next
		For idx = 0 To Small(buffer.Length,readbuf.Length)-1
			buffer[idx] = readbuf[idx]
		Next
		Return ret
	
	End Method

	Method xbload (filename:String, array:Int[], errmsg:String="")
		If FileType(filename) = 1 Then
			Local ff:TStream, byt:Byte, seg:Short, offset:Short, length:Short
			Local ilength:Int' as integer
			Local i:Int' as integer
			
			'ff = FreeFile
			ff = ReadFile(filename)
			If ff = Null Then
				DebugLog "ERMAGHERD"
				Return
			End If
			byt = ReadByte(ff)'GET #ff,, byt 'Magic number, always 253
			DebugLog "Magic: "+byt
			If byt <> 253 Then
				CloseFile(ff)
			
				DebugLog "bad header -  'file may also be zero length'"
				Return
			End If
			seg = ReadShort(ff)'GET #ff,, seg 'Segment, no use anymore
			offset = ReadShort(ff)'GET #ff,, offset 'Offset into the array, not used now
			length = ReadShort(ff)'GET #ff,, length 'Length
			'length is in bytes, so divide by 2, and subtract 1 because 0-based
			ilength = (length / 2) - 1
			
			Local buf:Short[ilength-1]' as Short
			
			For i = 0 To buf.Length-1
				buf[i] = ReadShort(ff)'GET #ff,, buf()
			Next
			CloseFile(ff)
			
			For i = 0 To small(ilength, array.Length)-1	
				array[i] = buf[i]
			Next 
		
		Else
			DebugLog "File corrupt or missing"
		End If
	End Method


	Method unlumpfile (status:TGadget=Null)'lumpfile as String, fmask as String, path as String, byval showerrors as bool = YES)
		Local lf:TStream' as integer
		Local dat:Byte' as ubyte
		Local size:Int' as integer
		Local maxsize:Int' as integer
		Local lname:String' as String
		Local namelen:Int' as integer  'not including nul
		Local bufr:TBank 'as ubyte Ptr
		Local nowildcards:Int = 0' as integer = 0
		Local path:String = Replace(filename,StripDir(filename),"")
		Local fmask:String = ""
		Local skiplump:Byte = True
		If FileType(filename) <> 1 Then
			DebugLog "unlumpfile: " + filename + " is not readable"
			'If showerrors Then showerror lumpfile + " is not readable"
			Return'Exit sub
		End If
		'lf = freefile
		lf = ReadFile(filename)'open lumpfile For binary access read as #lf
		maxsize = StreamSize( lf )'FileSize( filename )
		DebugLog "Max Size: "+maxsize
		'If Len(path) > 0 And Right(path, 1) <> SLASH Then path = path & SLASH
	
		'might want to change to a dynamic bank?
		bufr = CreateBank(16384)
		If bufr = Null Then
			CloseFile(lf)
			Return
		End If
	
		'should make browsing a bit faster
		'If Len(fmask) > 0 Then
		'	If Instr(fmask, "*") = 0 And Instr(fmask, "?") = 0 Then
		'		nowildcards = -1
		'	End If
		'End If
	
		dat = ReadByte(lf)'get #lf, , dat	'read first byte
		While Not Eof(lf)
			'get lump name
			lname = ""
			namelen = 0
			While Not Eof(lf) And dat <> 0 And namelen < 64
				lname = lname + Chr(dat)
				dat = ReadByte(lf)
				namelen = namelen + 1
			Wend
			If namelen > 50 Then
				DebugLog "unlumpfile: corrupt lump file " + filename + " : lump name too long: '" + lname + "'"
				'If showerrors Then showerror "File " + lumpfile + " seems to be corrupt"
				Exit' While
			End If
			lname = Lower(lname)
			DebugLog "lump name " + lname
	
			'If lname <> exclusive(lname, "abcdefghijklmnopqrstuvwxyz0123456789_-~. ") Then
				'debug "corrupt lump file " + lumpfile + " : unallowable lump name '" + lname + "'"
				'If showerrors Then showerror "File " + lumpfile + " seems to be corrupt"
				'Exit While
			'End If
	
			If Not Eof(lf) Then
				'get lump size - PDP-endian byte order = 3,4,1,2
				dat = ReadByte(lf)
				size = (dat Shl 16)
				dat = ReadByte(lf)
				size = size | (dat Shl 24)
				dat = ReadByte(lf)
				size = size | dat
				dat = ReadByte(lf)
				size = size | (dat Shl 8)
				'size = ReadInt(lf)
				If size > maxsize Then
					DebugLog filename + ": corrupt lump size " + size + " exceeds source size " + maxsize
					Notify filename + ": corrupt lump size " + size + " exceeds source size " + maxsize
					'If showerrors Then showerror "File " + lumpfile + " seems to be corrupt (possibly cut short)"
					
					Exit' While
				Else
					DebugLog "lump size: "+size
				End If
	
				'debuglog "lump size " + str(size)
	
				skiplump = True
	
				'do we want this file?
				If matchmask(lname, Lower(fmask)) = 1 Then
					'write yon file
					Local of:TStream' as integer
					Local csize:TBank' as integer
					If FileType(path + lname) = 1 Then
						DebugLog "(file already exists)"
					End If
					DebugLog "Write to file: "+path+lname
					If status <> Null Then
						SetStatusText( status,"Unlumping "+lname )
						PollEvent()
					EndIf

					of = WriteFile(path+lname)
					If of = Null Then
						DebugLog "unlumpfile(" + filename + ", " + fmask + "): " + path + lname + " not writable, skipping"
						'If FileType(path + lname) = 1 Then
						'	DebugLog "(file already exists)"
						'End If
						'If showerrors Then showerror "Could not unlump " & lname & " from " & lumpfile & ". Some game data will be missing."
						'exit while
					Else
						skiplump = False
						DebugLog "Writing Lump"
						'copy the data
						While size > 0
							'csize = CreateBank( size )'small(16384, size)
							'copy a chunk of file
							CopyBytes( lf,of,size )
							'fget lf, , bufr, csize
							'fput of, , bufr, csize
							
							'DER??
							size = size - size
						Wend
	
						CloseFile(of)
					End If
	
					'early out if we're only looking for one file
					If nowildcards  = 1 Then Exit' While
				Else
					
				End If
	
				If skiplump  = True Then
					'skip to next name
					Local endpos:Int' as integer
					endpos = StreamPos( lf )+size
					SeekStream( lf,endpos )
					
					DebugLog "Skipping Lump"
					
					'endpos = seek(lf) + size
					'seek #lf, endpos
				End If
	
				If Not Eof(lf) Then
					dat = ReadByte(lf)
				End If
			End If
		Wend
	
		'deallocate bufr
		CloseFile(lf)
		If status <> Null Then
			SetStatusText( status,"Finished Unlumping" )
			PollEvent()
		EndIf
		
	End Method

	Function defbinsize:Int(id:Int)' as integer
		'returns the default size in BYTES to use for getbinsize() when no BINSIZE data is available at all
		If id = 0 Then Return 0  'attack.bin
		If id = 1 Then Return 64 '.stf
		If id = 2 Then Return 0  'songdata.bin
		If id = 3 Then Return 0  'sfxdata.bin
		If id = 4 Then Return 40 '.map
		If id = 5 Then Return 0  'menus.bin
		If id = 6 Then Return 0  'menuitem.bin
		If id = 7 Then Return 0  'uicolors.bin
		If id = 8 Then Return 400  '.say
		If id = 9 Then Return 30   '.n##
		If id = 10 Then Return 636 '.dt0
		If id = 11 Then Return 320 '.dt1
		If id = 12 Then Return 200 '.itm
		Return 0
	End Function
	
	Function curbinsize:Int(id:Int)' as integer
		'returns the native size in BYTES of the records for the version you are running
		If id = 0 Then Return 560 'attack.bin
		If id = 1 Then Return 84  '.stf
		If id = 2 Then Return 32  'songdata.bin
		If id = 3 Then Return 34  'sfxdata.bin
		If id = 4 Then Return 404 '.map
		If id = 5 Then Return 54  'menus.bin
		If id = 6 Then Return 64  'menuitem.bin
		If id = 7 Then Return 126 'uicolors.bin
		If id = 8 Then Return 412 '.say
		If id = 9 Then Return 34  '.n##
		If id = 10 Then Return 858 '.dt0
		If id = 11 Then Return 736 '.dt1
		If id = 12 Then Return 422 '.itm
		Return 0
	End Function
	
	Function getbinsize:Int(id:Int)
		'returns the current size in BYTES of the records in the specific binary file you are working with
		If FileType(GamePath +"binsize.bin") = 1 Then
			Local recordsize:Short
			Local fh:TStream' as integer = FREEFILE
			fh = ReadFile(GamePath+"binsize.bin")'OPEN workingdir + SLASH + "binsize.bin" For BINARY as #fh
			If StreamSize(fh) < 2 * id + 2 Then
				DebugLog "Can't Seek - Default bin size: "+defbinsize(id)
				Return defbinsize(id)
				
			Else
				SeekStream(fh, id * 2)
				recordsize = ReadShort(fh)'GET #fh, 1 + id * 2, recordsize
				
			End If
			CloseFile(fh)
			
			DebugLog "Read Binsize: "+recordsize
			Return recordsize
		Else
			Local d:Int = defbinsize(id)
			DebugLog "Can't load: "+GamePath+"binsize.bin"+" Default Bin size: "+d
			Return d
		End If
	
	End Function
	
	'INTS, not bytes!
	Function dimbinsize:Int(id:Int)
		'curbinsize is size supported by current version of engine
		'getbinsize is size of records in RPG file
		Return (getbinsize(id)/2)'(Large(curbinsize(id), getbinsize(id)) / 2) - 1
	End Function

	Function maplumpname:String(map:Int, oldext:String)
		If map < 100 Then
			Return GamePath+Game+"."+oldext+Right("0"+map, 2)
		Else
			Return GamePath+map+"." +oldext
		End If
	End Function

	Function Large(a:Int,b:Int)
	
		If a > b Then
			Return a
		Else
			Return b
		EndIf
		Return a
	
	End Function
	
	Function Small(a:Int,b:Int)
	
		If a < b Then
			Return a
		Else
			Return b
		EndIf
		Return a
		
	End Function
	
	Function boundInt:Int(n:Int,lowest:Int,highest:Int)
		 'bound = n
		 If n < lowest Then Return lowest
		 If n > highest Then Return highest
		Return n
	End Function

	Function boundShort:Short(n:Short,lowest:Short,highest:Short)
		 'bound = n
		 If n < lowest Then Return lowest
		 If n > highest Then Return highest
		Return n
	End Function

	Function array2str:String(arr:Int[], o:Int,dest:Int[])
	'String dest is already filled out with spaces to the requisite size
	'o is the offset in bytes from the start of the buffer
	'the buffer will be packed 2 bytes to an int, for compatibility, even
	'though FB ints are 4 bytes long  ** leave like this? not really wise
		'Local dest:String
		Local i:Int
		Local bi:Int
		Local bp:Int[]
		Local toggle:Int
		Local name:String
		bp = arr
		'bp = @arr(0)
		bi = o / 2 'offset is in bytes
		toggle = o Mod 2
	
		For i = 0 To Len(dest) - 1
			If toggle = 0 Then
				dest[i] = bp[bi] & $ff
				toggle = 1
			Else
				dest[i] = (bp[bi] & $ff00) Shr 8
				toggle = 0
				bi = bi + 1
			End If
			name = name + Chr(dest[i])
		Next
		Return name
	End Function


	Function matchmask:Int(match:String, mask:String)
		Local i:Int' as integer
		Local m:Int' as integer
		Local si:Int,sm:Int' as integer, sm as integer
		Local matchmask:Int
		
		'special cases
		If mask = "" Then
			matchmask = 1
			Return 1
		End If
	
		i = 0
		m = 0
		While (i < Len(match)) And (m < Len(mask)) And (mask[m] <> Asc("*"))
			If (match[i] <> mask[m]) And (mask[m] <> Asc("?")) Then
				matchmask = 0
				Return 0
			End If
			i = i+1
			m = m+1
		Wend
	
		If (m >= Len(mask)) And (i < Len(match)) Then
			matchmask = 0
			Return 0
		End If
	
		While i < Len(match)
			If m >= Len(mask) Then
				'run out of mask with string left over, rewind
				i = si + 1 ' si will always be set by now because of *
				si = i
				m = sm
			Else
				If mask[m] = Asc("*") Then
					m = m + 1
					If m >= Len(mask) Then
						'* eats the rest of the string
						matchmask = 1
						Return 1
					End If
					i = i + 1
					'store the positions in case we need to rewind
					sm = m
					si = i
				Else
					If (mask[m] = match[i]) Or (mask[m] = Asc("?")) Then
						'ok, next
						m = m + 1
						i = i + 1
					Else
						'mismatch, rewind to last * positions, inc i and try again
						m = sm
						i = si + 1
						si = i
					End If
				End If
			End If
			Wend
		
		  	While (m < Len(mask)) And (mask[m] = Asc("*"))
		  		m = m + 1
		  	Wend
		
		  	If m < Len(mask) Then
				matchmask = 0
			Else
				matchmask = 1
		End If
	
	Return matchmask
		
	End Function	
	
End Type



Type Lump
	Field Ltype:Lumptype
	Field lumpname:String' as String
	Field length:Int' as integer
	Field bucket_chain:Lump' as LumpPtr
	'used to iterate over lumps in order they are in the file (or whatever else you want)
	Field seq:TList' as DListItem(Lump)
	Field index:LumpIndex'Ptr
	Field opencount:Int 'refcount
End Type


Type LumpUnion
	Field base:Lump '??BaseLump
	'union 
	Field lumped:LumpedLump
	Field file:FileLump
	'End union
End Type
'/

Type LumpIndex
	Field tablesize:Int' as integer
	Field table:Lump' Ptr Ptr
	Field lumps:TList' as DoubleList(Lump)
	'if non-zero, handle of open file
	Field fhandle:Int' as integer
	'if non-empty, directory containing FileLumps
	Field unlumpeddir:String' as String
End Type

Rem

sub construct_LumpIndex(byref this as LumpIndex)
	'Could call constructor too, but zeroed memory doesn't need it
	'this.numlumps = 0
	this.tablesize = 512
	'this.first = NULL
	'this.last = NULL
	dlist_construct(this.lumps.generic, offsetof(Lump, seq))
	this.table = callocate(SizeOf(any Ptr) * this.tablesize)
	this.fhandle = 0
	this.unlumpeddir = ""
End sub

sub destruct_LumpIndex(byref this as LumpIndex)
	dim as Lump Ptr lmp, temp

	If this.fhandle Then close this.fhandle

	lmp = this.lumps.first
	While lmp
		temp = lmp->seq.Next
		lmp->index = Null  'prevents the destructor from bothering to unlink
		lumpvtable(lmp->Type).destruct(*lmp)
		deallocate(lmp)
		lmp = temp
	Wend

	deallocate(this.table)

	this.Destructor()  'for strings
End sub

sub LumpIndex_addlump(byref this as LumpIndex, byval lump as Lump Ptr)
	dim hash as unsigned integer
	dim lmpp as Lump Ptr Ptr
	
	hash = strhash(lump->lumpname)
	lmpp = @this.table[hash Mod this.tablesize]
	While *lmpp
		lmpp = @(*lmpp)->bucket_chain
	Wend
	*lmpp = lump

	lump->index = @this

	dlist_append(this.lumps.generic, lump)
End sub

/' FIXME: looks totally broke. Where's the destructor call?
sub LumpIndex_dellump(byref this as LumpIndex, byval lump as Lump Ptr)
	dim hash as unsigned integer
	dim lmpp as Lump Ptr Ptr
	
	hash = strhash(lump->lumpname)
	lmpp = @this.table[hash Mod this.tablesize]
	While *lmpp
		If *lmpp = lump Then
			*lmpp = lump->bucket_chain
			Exit While
		End If
		lmpp = @(*lmpp)->bucket_chain
	Wend
	lump->bucket_chain = Null

	dlist_remove(this.lumps.generic, lump)
	lump->index = Null	
End sub
'/

'case sensitive
Function LumpIndex_findlump(byref this as LumpIndex, lumpname as String) as Lump Ptr
	dim hash as unsigned integer
	dim lmp as Lump Ptr

	hash = strhash(lumpname)
	lmp = this.table[hash Mod this.tablesize]
	While lmp
		If lmp->lumpname = lumpname Then Return lmp
		lmp = lmp->bucket_chain
	Wend

	Return Null
End Function

'verify integrity and print contents
sub LumpIndex_debug(byref this as LumpIndex)
	dim lmp as Lump Ptr
	dim lumped as LumpedLump Ptr
	dim numlumps as integer = 0

	debug "===LumpIndex_debug==="

	For i as integer = 0 To this.tablesize - 1
		lmp = this.table[i]
		While lmp
			numlumps += 1
			If (strhash(lmp->lumpname) Mod this.tablesize) <> i Then
				debug "LumpIndex_debug error: lump in wrong bucket"
			End If
			lmp = lmp->bucket_chain
		Wend
	Next

	If numlumps <> this.lumps.numitems Then
		debug "error: " & numlumps & " lumps in table, " & this.lumps.numitems & " recorded"
	End If

	numlumps = 0
	lmp = this.lumps.first
	do
		numlumps += 1
		debug lmp->lumpname
		If lmp->Type = LT_LUMPED Then
			lumped = cast(LumpedLump Ptr, lmp)
			debug "  at " & lumped->offset & " len " & lumped->length
		ElseIf lmp->Type = LT_FILE Then
			debug "  in " + this.unlumpeddir
		End If
		If lmp->seq.Next = Null Then
			If lmp <> this.lumps.last Then
				debug "error: ->last corrupt"
			End If
			Exit do
		End If
		lmp = lmp->seq.Next
	loop

	If numlumps <> this.lumps.numitems Then
		debug "error: " & numlumps & " lumps chained, " & this.lumps.numitems & " recorded"
	End If

	debug "====================="
End sub

End Rem
